home *** CD-ROM | disk | FTP | other *** search
/ Meeting Pearls 1 / Meeting Pearls Vol 1 (1994).iso / amok98-106 / amok106 / deskfinder / tooltypes.mod < prev    next >
Text File  |  1994-02-26  |  4KB  |  142 lines
  1. (****************************************************************
  2. :Program.       ToolTypes.mod
  3. :Contents.      To get "ToolTypes" from the programm Icon or CLI-Line
  4. :Author.        Matthias Taube
  5. :Copyright.     PublicDomain
  6. :Language.      Oberon
  7. :Translator.    Oberon 3.00d
  8. :History.       1.2 [Taube] 16-May-1993 fixed Bug using Icon.GetToolType (pointer odd)
  9.                 1.1 [Taube] 02-May-1993 include Cli-Support
  10. :Address.       D-5000 Köln 40,Ricarda Huch Str. 8
  11. :Phone.         02234/49233
  12. :Remark.        ONLY TESTET ON A3000 - KS/WB 37.x und KS/WB 39.x
  13. *****************************************************************)
  14.  
  15. MODULE ToolTypes;
  16. IMPORT Arguments, Conversions, Exec, Icon, OberonLib, Strings, SYSTEM, Workbench;
  17.  
  18. VAR wbs*:Workbench.WBStartupPtr;
  19.     MeinIcon*: Workbench.DiskObjectPtr;
  20.  
  21. PROCEDURE CopyStr(Von:ARRAY OF CHAR;VAR Nach:ARRAY OF CHAR;AbPos:INTEGER);
  22. (* Kopiert einen String ab einer Position bis zum Ende in einen anderen String *)
  23.   VAR VonPos,NachPos:INTEGER;
  24.   BEGIN
  25.     VonPos:=AbPos;NachPos:=0;
  26.     WHILE (NachPos<LEN(Nach)) AND (Von[VonPos]#00X) DO
  27.         Nach[NachPos]:=Von[VonPos];
  28.         INC(NachPos);INC(VonPos);
  29.     END;
  30.     Nach[NachPos]:=00X;
  31.   END CopyStr;
  32.  
  33. PROCEDURE StripQuote(VAR String:ARRAY OF CHAR);
  34. (* Entfernt die Anführungszeichen und die führenden und endenden Leerzeichen
  35.    aus einem String *)
  36.   VAR Pos:INTEGER;
  37.       Quote:CHAR;
  38.   BEGIN
  39.     Pos:=0;
  40.     (* führende Leerzeichen entfernen *)
  41.     WHILE (String[Pos]=" ") DO
  42.       INC(Pos);
  43.     END;
  44.     (* führendes Anführungszeichen entfernen *)
  45.     IF (String[Pos]="'") OR (String[Pos]='"') THEN
  46.        Quote:=String[Pos]; INC(Pos);
  47.     ELSE Quote:=" ";
  48.     END;
  49.     CopyStr(String,String,Pos);
  50.     Pos:=SHORT(Strings.Length(String));
  51.     WHILE ((String[Pos]=" ") OR (String[Pos]=00X)) AND (Pos>=0) DO
  52.       DEC(Pos);
  53.     END;
  54.     IF String[Pos]=Quote THEN DEC(Pos); END;
  55.     String[Pos+1]:=00X;
  56.   END StripQuote;
  57.  
  58. PROCEDURE GetToolRawStr* (Pattern:ARRAY OF CHAR;VAR in: Exec.STRING):BOOLEAN;
  59.  
  60. (* Liefert das Argument in der Variable in den String, so wie es in den ToolTypes
  61.    steht.
  62.    Beim Start vom Cli werden die Argumente nach dem String "Pattern=..."
  63.    durchsucht und danach String hinter dem Gleichheitszeichen ausgewertet. *)
  64.  
  65.   VAR i:INTEGER;
  66.       Pos:LONGINT;
  67.       Ok:BOOLEAN;
  68.       Temp:Exec.LSTRPTR;
  69.       TempStr:Exec.STRING;
  70.   BEGIN
  71.     IF MeinIcon#NIL THEN
  72. (* $OddChk- *)
  73.       Temp:=Icon.FindToolType(MeinIcon.toolTypes,Pattern);
  74.       IF Temp#NIL THEN
  75.         Exec.CopyMemAPTR(Temp,SYSTEM.ADR(in),SIZE(in));
  76.         RETURN(TRUE);
  77.       END;
  78. (* $OddChk= *)
  79.     ELSE (* Programm hat kein Icon oder wurde über den Cli gestartet *)
  80.       IF NOT OberonLib.wbStarted THEN
  81.          i:=Arguments.NumArgs();
  82.          REPEAT
  83.            Arguments.GetArg(i,in);
  84.            TempStr:=in;
  85.            Strings.Upper(TempStr); (* Strings.UpperIntl enthält einen Bug! *)
  86.            Strings.Upper(Pattern);
  87.            Pos:=Strings.Occurs(TempStr,Pattern);
  88.            IF Pos = 0 THEN
  89.              Pos:=Strings.Length(Pattern);
  90.              IF TempStr[Pos]="=" THEN
  91.                CopyStr(in,in,SHORT(Pos)+1);
  92.                RETURN(TRUE);
  93.              END;
  94.            END;
  95.            DEC(i);
  96.          UNTIL (i<1);
  97.        END;
  98.      END;
  99.      in:="";
  100.      RETURN(FALSE);
  101.   END GetToolRawStr;
  102.  
  103. PROCEDURE GetToolString*(Pattern:ARRAY OF CHAR;VAR in:ARRAY OF CHAR):BOOLEAN;
  104. (* von dem String hinter ToolType werden die Tüttelchen entfernt, er
  105.    wird in einen beliebigen String kopiert. *)
  106.   VAR TMPStr:Exec.STRING;
  107.       VonPos,NachPos:INTEGER;
  108.   BEGIN
  109.     IF GetToolRawStr(Pattern,TMPStr) THEN
  110.       StripQuote(TMPStr);
  111.       CopyStr(TMPStr,in,0);
  112.       RETURN(TRUE);
  113.     END;
  114.     in:="";
  115.     RETURN(FALSE);
  116.   END GetToolString;
  117.  
  118. PROCEDURE GetToolInt*(Pattern:ARRAY OF CHAR;Default:LONGINT):LONGINT;
  119. (* Wertet Tools aus, die Integerargumente beinhalten *)
  120.   VAR Temp:Exec.STRING;
  121.       Aus:LONGINT;
  122.   BEGIN
  123.     IF GetToolString(Pattern,Temp) THEN
  124.       IF Conversions.StringToInt(Temp,Aus) THEN RETURN(Aus); END;
  125.     END;
  126.     RETURN(Default);
  127.   END GetToolInt;
  128.  
  129.  
  130.  
  131.  
  132. BEGIN
  133.   IF OberonLib.wbStarted THEN
  134.     wbs := OberonLib.wbenchMsg; (* wird von Arguments nicht exportiert *)
  135.     MeinIcon := Icon.GetDiskObject(wbs.argList[0].name^);
  136.   ELSE MeinIcon:=NIL;wbs:=NIL;
  137.   END;
  138. CLOSE
  139.   IF MeinIcon#NIL THEN Icon.FreeDiskObject(MeinIcon);END;
  140. END ToolTypes.
  141.  
  142.